home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / pq2mut.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-16  |  42.0 KB  |  1,293 lines

  1. module MenuUtils;
  2.  
  3. { Abstract:
  4.  
  5. {       The procedure GetPList invokes the menues, starting with the 
  6. {       root menu, and returns a 'parse list' containing the 
  7. {       selections the user has made when traversing the menu tree 
  8. {       out to a leaf.
  9.  
  10. {       The user may enter the selections either by typing the commands,
  11. {       or by invoking PopUp-menues.  Online help will always be available,
  12. {       and the user will never have committed himself to any choice before
  13. {       the last choice (i.e. the leaf) has been done.
  14. }
  15.  
  16. {==============================} exports {===================================}
  17.  
  18. imports PopUp from PopUp;
  19.  
  20.  
  21. type
  22.         NodeType     =  ( MenuNode, ParmNode, EndNode );
  23.  
  24.         HelpAddress  =  record
  25.                             BlockNo : integer;
  26.                             Offset  : integer;
  27.                         end;
  28.  
  29.         pMenuEntry   =  ^MenuEntry;     { Pointer to menu hierarchy }
  30.         MenuEntry    =  record
  31.                                 { Where to find help on this item }
  32.                             Help        : HelpAddress;
  33.                                 { How to prompt for next selection }
  34.                             Prompt                  : S25;
  35.                             case Node   : NodeType of
  36.  
  37.                                 MenuNode:   { A real menu } 
  38.                                        (MPtr      : pNameDesc;
  39.                                         NextLevel : array [1..1] 
  40.                                                             of pMenuEntry);
  41.  
  42.                                 ParmNode:   { A leaf, expecting a parameter } 
  43.                                        ();
  44.                                         
  45.                                 EndNode:    { A leaf, no parameter }
  46.                                        ()
  47.                          end;
  48.  
  49.         
  50.         pPListEntry  =  ^PListEntry;    { Parse list pointer }
  51.         PListEntry   =  record          { Parse list item }
  52.                             PrevPList   : pPListEntry;
  53.                             CurrMenu    : pMenuEntry;
  54.                             CmdI        : integer;
  55.                             case Node   : NodeType of
  56.                                         { Menu selection }
  57.                                 MenuNode    : ( NextPList   : pPListEntry;
  58.                                                 Selection   : integer);
  59.                                         { The possible tails of the list }
  60.                                 ParmNode    : ( Arg         : String );
  61.                                 EndNode     : ()
  62.                         end;
  63.                  
  64. procedure   InitMenues;
  65. procedure   DestroyMenues;
  66. function    GetMenu( MenuFName, HelpFName : String ) : pMenuEntry;
  67.  
  68. exception   NoMenuFile( MenuFName : String );  
  69. exception   BadMenuFile( AtLine : Integer );
  70.  
  71. function    GetMenuAnswer(MPtr:pNameDesc;  NPix:integer):integer;
  72. function    PushCmdFile( FileName : String ) : Boolean;
  73. procedure   GetPList( root : pMenuEntry; var PListPtr : pPListEntry );
  74. procedure   DestroyPList( var PListPtr : pPListEntry );
  75.  
  76. {===========================================================================}
  77. {==============================} private {==================================}
  78.  
  79.     
  80.  
  81. imports Memory from Memory;
  82. imports FileSystem from FileSystem;
  83. imports System from System;
  84. imports Screen from Screen;
  85. imports Perq_String from Perq_String;
  86. imports MultiRead from MultiRead;
  87. imports IO_Unit from IO_Unit;
  88. imports IO_Others from IO_Others;
  89. imports IOErrors from IOErrors;
  90. imports Stream from Stream;  
  91.  
  92. const
  93.         HelpCommand = 'HELP';
  94.  
  95.         DefSeg          =     0;
  96.         UseCursorPos    =    -1;
  97.         NotList         = false;
  98.         ColWidth        =     8;
  99.         ScreenWidth     =    75;
  100.         MenuSize        =   200;  { Max. height of menu }
  101.         CommentChar     =   '!';
  102.         NumLevels       =    20;
  103.         Fold            =  true;
  104.         MaxCLine        =   132;  { Max. length of command line }
  105.         TabKey          =   Chr(128);        
  106.         CR              =   Chr( 13);
  107.         Escape          =   Chr( 27);
  108.         BS              =   Chr(  8);
  109.         DEL             =   Chr(127);
  110.         CtrlU           =   Chr( 21);
  111.         CtrlW           =   Chr( 23); 
  112.         CtrlX           =   Chr( 24);
  113.  
  114.         KeyChar         =   Chr( 24);
  115.         CmdFChar        =   Chr( 26);
  116.  
  117. type
  118.     pInt = ^Integer;
  119.  
  120.     CLine = packed array [1..MaxCLine] of char; 
  121.     CBuff = record
  122.                 Prompt      : String;
  123.                 Cmd         : CLine;
  124.                 BufCur      : 0..MaxCLine;  { character index in buffer}
  125.                 CurrPList   : pPListEntry;  { last entry in parse list }
  126.                 Comment     : Boolean;
  127.                 CommPos,
  128.                 HelpPos     : Integer;    
  129.             end;
  130.                 
  131.     ParseResult =
  132.         ( ParsedOK, WantHelp, NotFound, NotUnique );
  133.  
  134.  
  135. var
  136.     NullMenu        : pNameDesc;
  137.     ShowMenues      : boolean;
  138.     CmdStack        : Array [1..NumLevels] of text;
  139.     CmdLevel        : 0..NumLevels;
  140.     PromptChar      : Char;
  141.  
  142.     EndMenu,
  143.     ParmMenu        : pNameDesc;
  144.  
  145. {===========================================================================}
  146.  
  147. procedure RefreshCBuff( VAR CB : CBuff );
  148. VAR I : Integer;
  149. begin
  150.     with CB do begin
  151.         write( Prompt, PromptChar );
  152.         for I := 1 to BufCur-1 do write( Cmd[I] );
  153.     end;
  154. end;
  155.  
  156. {===========================================================================}
  157.  
  158. function CmdEndCBuff( VAR CB : CBuff ) : integer;
  159. VAR I : Integer;
  160. begin
  161.     with CB do 
  162.         if CurrPList=NIL then 
  163.             CmdEndCBuff := 1
  164.         else begin
  165.             I := CurrPList^.CmdI;
  166.             while (Cmd[i]<>' ') and (Cmd[i]<>CR) and 
  167.                   (Cmd[i]<>CommentChar) and (I<BufCur) do 
  168.                 I := I + 1;
  169.             CmdEndCBuff := I;
  170.         end;
  171. end;
  172.  
  173. {===========================================================================}
  174.  
  175. function    PushCmdFile( FileName : String ) : Boolean;
  176.  
  177.         handler ResetError( FileName : PathName );
  178.         begin
  179.              PushCmdFile := False;
  180.              exit( PushCmdFile );
  181.         end;
  182.  
  183. begin
  184.     PushCmdFile := True;
  185.     if CmdLevel<NumLevels then begin
  186.         Reset( CmdStack[CmdLevel+1], FileName );
  187.         CmdLevel := CmdLevel + 1;
  188.         PromptChar := CmdFChar;
  189.     end;
  190. end;
  191.  
  192. {===========================================================================}
  193.  
  194. function GetChar : Char;
  195. var C       : Char;
  196.     Done    : Boolean;
  197. begin
  198.     if CmdLevel=0 then begin
  199.         SCurOn;
  200.         Done := False;
  201.         while not Done do begin
  202.             if (IOCRead( TransKey, C )=IOEIOC) then begin
  203.                 Done := True;
  204.             end else if TabSwitch then begin
  205.                 Done := True;
  206.                 C := TabKey; 
  207.             end;
  208.         end;
  209.         SCurOff;
  210.     end else begin
  211.         if EOF( CmdStack[CmdLevel] ) then begin     { Pop stack }
  212.             Close( CmdStack[CmdLevel] );
  213.             CmdLevel := CmdLevel - 1;
  214.             if CmdLevel=0 then PromptChar := KeyChar;
  215.             C := CR;
  216.         end else
  217.             if EOLn( CmdStack[CmdLevel] ) then begin
  218.                 Read( CmdStack[CmdLevel] , C );
  219.                 C := CR;
  220.             end else
  221.                 Read( CmdStack[CmdLevel], C );
  222.     end;
  223.     GetChar := C;
  224. end;   { GetChar } 
  225.  
  226. {=============================================================================}
  227.  
  228. function FieldWidth( L : integer ):integer;
  229. begin
  230.     FieldWidth := (( L + ColWidth ) div ColWidth ) * ColWidth;
  231. end;
  232.  
  233. {===========================================================================}
  234.  
  235. procedure PushPList( VAR CB : CBuff; NewMenu : PMenuEntry );
  236. var P : pPListEntry;
  237.     I : Integer;
  238. begin
  239.     with CB do begin
  240.         case NewMenu^.Node of
  241.             MenuNode:   New( P, MenuNode );
  242.             ParmNode:   New( P, ParmNode );
  243.             EndNode:    New( P, EndNode );
  244.         end;
  245.         with P^ do begin
  246.             Node := NewMenu^.Node;
  247.             CurrMenu := NewMenu;
  248.             PrevPList := CurrPList;
  249.             I := CmdEndCBuff( CB );
  250.             while ((Cmd[i]=' ') or (Cmd[i]=CR)) and (I<BufCur) do I := I + 1;
  251.             CmdI := I;
  252.             if Node=MenuNode then begin
  253.                 NextPList := NIL;
  254.                 Selection := 0;
  255.             end else if Node=ParmNode then
  256.                 Arg := '';
  257.         end;
  258.         if CurrPList<>NIL then
  259.             CurrPList^.NextPList := P;
  260.         CurrPList := P;
  261.     end;
  262. end; 
  263.  
  264. {===========================================================================}
  265.  
  266. procedure InitCBuff( VAR CB : CBuff; M : pMenuEntry );
  267. begin
  268.     with CB do begin
  269.         Prompt      := M^.Prompt;
  270.         BufCur      := 1;
  271.         CurrPList   := NIL;
  272.         Comment     := False;
  273.         CommPos     := 0;
  274.         HelpPos     := 0;
  275.     end;
  276.     PushPList( CB, M );
  277. end;
  278.  
  279. {===========================================================================}
  280.  
  281. function CComp( C1, C2 : Char ) : Boolean;
  282. begin
  283.     if C1=C2 then
  284.         CComp := true
  285.     else 
  286.         if not Fold then
  287.             CComp := false
  288.         else begin
  289.             if (C1>='a') and (C1<='z') then
  290.                 C1 := Chr( Ord(C1)-Ord('a')+Ord('A') );
  291.             if (C2>='a') and (C2<='z') then
  292.                 C2 := Chr( Ord(C2)-Ord('a')+Ord('A') );
  293.             CComp := C1=C2;
  294.         end;
  295. end;
  296.  
  297. {===========================================================================}
  298.  
  299. procedure IntoCBuff( VAR CB : CBuff;  C : Char );
  300. begin
  301.     with CB do begin
  302.         if BufCur<MaxCLine then begin
  303.             Cmd[BufCur] := C;
  304.             if C>=' ' then      { Echo character }
  305.                 write(C);
  306.             with CurrPList^ do
  307.                 if (CmdI=BufCur) and (C=' ') then
  308.                     CmdI := CmdI + 1;
  309.             BufCur := BufCur + 1;
  310.         end;
  311.     end;
  312. end;
  313.  
  314. {===========================================================================}
  315.  
  316. procedure BackCBuff( VAR CB : CBuff; ToPos : Integer );
  317. VAR I : Integer;
  318. begin
  319.     with CB do begin
  320.         if ToPos>BufCur then ToPos := BufCur;
  321.         if ToPos<1 then ToPos := 1;
  322.         
  323.         if Comment and (ToPos<=CommPos) then
  324.             Comment := False;
  325.  
  326.         for I := BufCur-1 downto ToPos do begin
  327.             if Cmd[I]>=' ' then             { Character was echoed to screen }
  328.                 SClearChar( Cmd[I], RXor );
  329.         end;
  330.         BufCur := ToPos;
  331.  
  332.             { Pop the last entries off the parse list, if necessary }
  333.         while (CurrPList^.CmdI>BufCur) and (CurrPList^.PrevPList<>NIL) do begin
  334.             CurrPList := CurrPList^.PrevPList;
  335.         end;
  336.     
  337.         with CurrPList^ do begin
  338.             if CmdI>BufCur then         { Could not pop last item }
  339.                 CmdI := BufCur;         { Just note that there are no chars }
  340.             if (NextPList<>NIL) and (Node=MenuNode) then begin
  341.                 Selection := 0;
  342.                 DestroyPList( NextPList );
  343.                 NextPList := NIL;
  344.             end;
  345.         end;
  346.         if ToPos<=HelpPos then
  347.             HelpPos := 0;
  348.     end;
  349. end;
  350.  
  351. {===========================================================================}
  352.  
  353. procedure NextCmdCBuff( VAR CB : CBuff );
  354. { Push to next command in buffer }
  355. VAR I : Integer;
  356. begin
  357.     with CB, CurrPList^, CurrMenu^ do begin
  358.         I := CmdEndCBuff( CB );
  359.         if (I<BufCur) then
  360.             if (Selection>1) and (Selection<=MPtr^.NumCommands) then
  361.             begin
  362.                 {$Range-}
  363.                 PushPList( CB, NextLevel[Selection] );
  364.                 {$Range=}
  365.             end else if Selection=1 then begin
  366.                 if HelpPos=0 then
  367.                     HelpPos := CurrPList^.CmdI;
  368.                 PushPList( CB, CurrMenu );
  369.             end;
  370.     end;
  371. end;
  372.  
  373. {===========================================================================}
  374.  
  375. function FindMatch( VAR CB  : CBuff; 
  376.                     VAR Pos : integer ) : Boolean;
  377.  
  378. { Abbreviated command lookup.  Starting from "Pos", see if any command in   }
  379. { command table matches the word starting at CmdI in CB and ending at       }
  380. { BufCur -1 or first space or other delimiting character.                   }
  381.  
  382. var GiveUp                  : Boolean;
  383.     CmdEnd, CmdLen, I, J    : Integer;
  384. begin
  385.     with CB, CurrPList^.CurrMenu^.MPtr^ do begin
  386.  
  387.         CmdEnd := CmdEndCBuff( CB );
  388.         GiveUp := True;
  389.         while (Pos<NumCommands) and (GiveUp) do begin
  390.  
  391.                 { Look if Cmd matches command in table }
  392.             Pos := Pos + 1; 
  393.             I := CurrPList^.CmdI;
  394.             J := 1;
  395.             {$Range-}
  396.             CmdLen := Length(Commands[Pos]);
  397.             GiveUp := False;
  398.             while (I<CmdEnd)  and (not GiveUp) do begin
  399.                 if CComp( Commands[Pos][J], Cmd[I] ) then begin
  400.                     J := J+1;           { Matching characters, step both }
  401.                     I := I+1;           { indices forward in commands    }
  402.                     if (J>CmdLen) and (I<CmdEnd) then 
  403.                         GiveUp := True;
  404.                 end else 
  405.                     if Cmd[I]='-' then begin { Cmd is abbreviated, just  }
  406.                         J := J+1;       { step the other index forward   }
  407.                         if J>CmdLen then        { Need something to match }
  408.                             GiveUp := True;     { this character to!      }
  409.                     end else begin
  410.                         GiveUp := True;
  411.                     end;  
  412.             end;
  413.             {$Range=}
  414.         end;
  415.         
  416.         FindMatch := not GiveUp;
  417.     end;
  418. end;    { FindMatch }
  419.  
  420. {===========================================================================}
  421.  
  422. procedure ShowWord( VAR CB : CBuff );
  423. VAR I : Integer;
  424. begin
  425.     with CB do begin
  426.         write('''');
  427.         I := CurrPList^.CmdI;
  428.         while (Cmd[I]<>' ') and (I<BufCur) do begin
  429.             write(Cmd[I]);
  430.             I := I + 1;
  431.         end;
  432.         write('''');
  433.     end;
  434. end;
  435.  
  436. {===========================================================================}
  437.  
  438. function ParseCBuff( VAR CB : CBuff ) : ParseResult;
  439. VAR I, J : Integer;
  440. begin
  441.     with CB, CurrPList^ do
  442.  
  443.     Case Node of 
  444.         MenuNode:
  445.             begin
  446.                 I := 0; 
  447.                 if not FindMatch( CB, I ) then begin
  448.                     ParseCBuff := NotFound;
  449.                     CurrPList^.Selection := 0;
  450.                 end else begin
  451.                     CurrPList^.Selection := I;
  452.                     J := I;
  453.                     if FindMatch( CB, J ) then begin
  454.                         ParseCBuff := NotUnique;
  455.                     end else begin
  456.                         NextCmdCBuff( CB );
  457.                         ParseCBuff := ParsedOK;
  458.                     end;
  459.                 end;            
  460.             end;
  461.  
  462.         ParmNode:
  463.             begin
  464.                 if BufCur>1 then
  465.                     if (Cmd[BufCur-1]=CR) or (Cmd[BufCur-1]=' ') then begin
  466.                         Adjust( Arg, BufCur-1-CurrPList^.CmdI );
  467.                         I := 1;
  468.                         for J := CurrPList^.CmdI to BufCur-2 do begin
  469.                             Arg[I] := Cmd[J];
  470.                             I := I + 1;
  471.                         end;
  472.                     end;
  473.                 ParseCBuff := ParsedOK;
  474.             end;
  475.             
  476.         EndNode:
  477.             begin
  478.                 if BufCur>1 then
  479.                     if Cmd[BufCur-1]=CR then 
  480.                         if BufCur>CurrPList^.CmdI then begin
  481.                             writeln;
  482.                             write('?Garbage at end of line, ignored ''');
  483.                             for I := CurrPList^.CmdI to BufCur-2 do 
  484.                                 write( Cmd[I] );
  485.                             writeln('''');
  486.                             RefreshCBuff( CB );
  487.                         end;
  488.                 ParseCBuff := ParsedOK;
  489.             end;
  490.     end;
  491. end;
  492.  
  493. {===========================================================================}
  494.  
  495. function    ParseAll( VAR CB : CBuff ) : ParseResult;
  496. { -- Reparse command buffer as far as possible }
  497. var PRes        : ParseResult;
  498.     PrevCmdI,
  499.     TempPos     : Integer;
  500.     TempChar    : Char;
  501. begin
  502.     with CB do begin
  503.         if Comment then begin
  504.             TempPos := BufCur;
  505.             BufCur := CommPos + 1;
  506.             TempChar := Cmd[CommPos];
  507.             Cmd[CommPos] := ' ';
  508.         end;
  509.         if (CmdEndCBuff(CB)<>CurrPList^.CmdI) then begin
  510.             repeat
  511.                 PrevCmdI := CurrPList^.CmdI;
  512.                 PRes := ParseCBuff(CB);
  513.             until (PRes<>ParsedOK) or (PrevCmdI=CurrPList^.CmdI)
  514.                         or (CmdEndCBuff(CB)=CurrPList^.CmdI);
  515.             ParseAll := PRes;
  516.         end else
  517.             ParseAll := ParsedOK;
  518.  
  519.         if Comment then begin
  520.             Cmd[CommPos] := TempChar;
  521.             BufCur := TempPos; 
  522.         end;
  523.     end;    
  524. end;
  525.  
  526. {===========================================================================}
  527.  
  528. procedure ParseCommand(     root        : pMenuEntry; 
  529.                         var PListPtr    : pPListEntry;
  530.                             HelpMode,
  531.                             RootLevel   : Boolean );
  532.  
  533. const
  534.     MoreInfo = 'More info on:';
  535.     SelPrompt = 'Select item:';
  536.     SelectOne = 'Select one of the following: ';
  537.     CommNotUnique = '?Command is not unique: ';
  538. var
  539.     C                   : Char;
  540.     Done, QuestionMark  : boolean;
  541.     NextMatch,
  542.     I, J, CmdEnd        : integer;
  543.     Matching            : S25;
  544.     CB                  : CBuff;       { Command buffer to use}
  545.     TabPress            : Boolean;     { Select done by menu? }
  546.     PRes                : ParseResult;
  547.     Dummy, ArgEntry     : pPListEntry;
  548.  
  549.     HelpFile    : pInt;
  550.     HelpFID     : integer;
  551.     HFBuff      : pDirBlk;
  552.     HFAddr      : HelpAddress;
  553.     MM          : MMPointer;
  554.  
  555.  
  556.     handler HelpKey( var retStr : Sys9s );
  557.     begin
  558.         retStr := 'HELP
  559. ';
  560.     end;
  561.     
  562.     {------------------------------------------------------------------------}
  563.  
  564.     procedure PrintHelpText;
  565.     var PrevCR      : boolean;
  566.     begin
  567.         if HelpFID=0 then 
  568.             writeln('No helptext found!')
  569.         else
  570.             with CB.CurrPList^.CurrMenu^ do begin
  571.                 if HFaddr.BlockNo<>Help.BlockNo then
  572.                     FSBlkRead( HelpFID, Help.BlockNo, HFBuff ); 
  573.                 HFAddr := Help;
  574.                 PrevCR := true;
  575.                 with HFAddr, HFBuff^ do 
  576.                     while not( PrevCR and (ByteBuffer[Offset]=ord('>'))) do
  577.                     begin
  578.                         PrevCR := ByteBuffer[Offset]=13;
  579.                         write( chr(ByteBuffer[Offset]) );
  580.                         if PrevCR then write( chr(10) );
  581.                         Offset := Offset+1;
  582.                         if Offset>511 then begin
  583.                             Offset := 0;
  584.                             BlockNo := BlockNo + 1;
  585.                             FSBlkRead( HelpFID, BlockNo, HFBuff );
  586.                         end;
  587.                     end;
  588.             end;
  589.     end;  { PrintHelpText }  
  590.  
  591.     {------------------------------------------------------------------------}
  592.  
  593.     procedure PrintAlts;
  594.     var i,l,w,s         : integer;
  595.         Matching        : S25;
  596.     begin
  597.         L := 0;
  598.         with CB.CurrPList^.CurrMenu^, MPtr^ do 
  599.         if Node=MenuNode then begin
  600.  
  601.             if HelpMode then 
  602.                 writeln( MoreInfo )
  603.             else
  604.                 writeln( SelectOne );
  605.             for i := 2 to NumCommands do begin
  606.                 {$range-}
  607.                 Matching := Commands[i];
  608.                 S := Length( Matching );
  609.                 W := FieldWidth( S );
  610.                 L := L+W;
  611.                 if L < ScreenWidth then
  612.                     write( Matching, ' ':(W-S) )
  613.                 else if L = ScreenWidth then begin
  614.                     writeln( Matching ); 
  615.                     L := 0;
  616.                 end else begin
  617.                     writeln;
  618.                     write( Matching, ' ':(W-S) );
  619.                     L := W;
  620.                 end;
  621.                 {$range=} 
  622.             end;
  623.  
  624.         end;
  625.         if L<>0 then writeln;
  626.     end;
  627.  
  628.     {------------------------------------------------------------------------}
  629.     
  630.     procedure PrintMatching;
  631.     var i,l,w,s         : integer;
  632.         Matching        : S25;
  633.     begin
  634.         L := 0;
  635.         I := 0;
  636.         writeln( SelectOne );
  637.         with CB.CurrPList^.CurrMenu^.MPtr^ do 
  638.             while FindMatch( CB, I ) do begin
  639.                 {$Range-}
  640.                 Matching := Commands[I];
  641.                 {$Range=}
  642.                 S := Length( Matching );
  643.                 W := FieldWidth( S );
  644.                 L := L+W;
  645.                 if L < ScreenWidth then
  646.                     write( Matching, ' ':(W-S) )
  647.                 else if L = ScreenWidth then begin
  648.                     writeln( Matching ); 
  649.                     L := 0;
  650.                 end else begin
  651.                     writeln;
  652.                     write( Matching, ' ':(W-S) );
  653.                     L := W;
  654.                 end;
  655.             end;
  656.         if L<>0 then writeln;
  657.     end;
  658.  
  659.     {------------------------------------------------------------------------}
  660.  
  661.     procedure DoHelp;
  662.     begin
  663.         writeln;
  664.         writeln;
  665.         PrintHelpText;
  666.         writeln;
  667.         PrintAlts;
  668.         writeln;
  669.     end;
  670.  
  671.     {------------------------------------------------------------------------}
  672.     
  673.     procedure ExplainHelp;
  674.     begin
  675.         writeln;
  676.         writeln;
  677.         write('HELP - online help facility');
  678.         writeln;
  679.         writeln('Use the "HELP" command to obtain command explanations');
  680.         writeln('"HELP" may replace any command, and the effect will be to');
  681.         writeln('explain this command and list the various alternatives.');
  682.         writeln;
  683.         writeln('"HELP" may be used in different ways: ');
  684.         writeln('"HELP" as the last command on the line, before RETURN, will');
  685.         writeln('enter the help mode, where every command entered not is ');
  686.         writeln('executed, but explained.  Exit help mode by entering an ');
  687.         writeln('empty line.');
  688.         writeln('When the "HELP" command is not at the end of the line, ');
  689.         writeln('the result will be to explain the commands after HELP ');
  690.         writeln('and then continue entering commands to execute.'); 
  691.         writeln;
  692.         writeln('Function keys:');
  693.         writeln('RETURN (CR) terminates the command and executes it.  If ');
  694.         writeln('   the command is partially entered, the command tail will ');
  695.         writeln('   be prompted for.  The command may then be aborted by ');
  696.         writeln('   entering a blank line.');
  697.         writeln('INS (ESC) expands the last command on the line, if it is ');
  698.         writeln('   abbreviated, and it is unique.  Use to check if a valid');
  699.         writeln('   command is entered, and that the abbreviation really');
  700.         writeln('   identifies the correct command.');
  701.         writeln('''?'' lists the commands that matches an abbreviation. ');
  702.         writeln('''??'' enters help mode. ');
  703.         writeln('''!'' is a comment delimiter.  (Most useful in command ');
  704.         writeln('   files.)  Everything between ''!'' and end of line is ');
  705.         writeln('   ignored.'); 
  706.         writeln('BACKSPACE, DEL deletes the last character on the line.');
  707.         writeln('OOPS, Ctrl-U, Ctrl-X deletes the whole line.');
  708.         writeln('Ctrl-W deletes the last word (back to previous space) ');
  709.         writeln;
  710.     end;    { ExplainHelp }
  711.  
  712.     {------------------------------------------------------------------------}
  713.  
  714.  
  715. begin  { GetPList } 
  716.     MM := recast( Root, MMPointer );
  717.     HelpFile := MakePtr( MM.Segmen, 0, pInt );
  718.     HelpFID := HelpFile^;
  719.     HFAddr.BlockNo := -1;       { Note help buffer is empty }
  720.     new( HFBuff);
  721.  
  722.     Done := false;
  723.     InitCBuff( CB, Root );
  724.     if HelpMode then begin
  725.         DoHelp;
  726.         CB.Prompt := SelPrompt;
  727.     end;
  728.     RefreshCBuff( CB );
  729.     PListPtr := CB.CurrPList; 
  730.     QuestionMark := False;
  731.  
  732.     with CB do
  733.       while not Done do begin
  734.       
  735.         C := GetChar;
  736.  
  737.         if (C=TabKey) then begin                { Insert dummy space to     }
  738.             IntoCBuff( CB, ' ' );               { make parse go all the way }
  739.             PRes := ParseAll(CB);               { to the end of buffer.     }
  740.             BackCBuff( CB, BufCur-1 );          { Remove the dummy space.   }
  741.             if BufCur>CurrPList^.CmdI then
  742.                 BackCBuff( CB, CurrPList^.CmdI );      { ..partial command }
  743.             Dummy := CurrPList;
  744.             repeat
  745.                 case CurrPList^.Node of
  746.                 
  747.                 MenuNode:
  748.                     begin
  749.                         I := GetMenuAnswer( CurrPList^.CurrMenu^.MPtr, 
  750.                                                 MenuSize );
  751.                         if I>1 then begin
  752.                             CurrPList^.Selection := I;
  753.                             {$Range-}
  754.                             Matching := CurrPList^.CurrMenu^.MPtr^.Commands[i];
  755.                             {$Range=}
  756.                             for J := 1 to length(Matching) do begin
  757.                                 IntoCBuff(CB,Matching[j]);
  758.                             end;
  759.                             IntoCBuff(CB, ' ');
  760.                             NextCmdCBuff(CB); 
  761.                         end;
  762.                     end;
  763.  
  764.                 EndNode:
  765.                     begin
  766.                         if HelpMode then begin
  767.                             I := 1;
  768.                         end else 
  769.                             I := GetMenuAnswer( EndMenu, MenuSize );
  770.                         if I=2 then I := -1;
  771.                     end;
  772.                 
  773.                 ParmNode:
  774.                     begin 
  775.                         if HelpMode then begin
  776.                             I := 1;
  777.                         end else 
  778.                             I := GetMenuAnswer( ParmMenu, MenuSize );
  779.                         if I=2 then begin
  780.                             writeln;
  781.                             ParseCommand( CurrPList^.CurrMenu, ArgEntry, 
  782.                                     HelpMode, false );
  783.                             CurrPList^.Arg := ArgEntry^.Arg;
  784.                             DestroyPList( ArgEntry );
  785.                             I := -1;
  786.                         end else if I=3 then begin
  787.                             CurrPList^.Arg := '';
  788.                             I := -1;
  789.                         end;
  790.                     end;
  791.                 end;
  792.  
  793.                 if I=1 then begin 
  794.                     writeln;
  795.                     writeln;
  796.                     PrintHelpText;
  797.                     writeln;
  798.                     write('Press tabswitch to get menu back: ');
  799.                     while TabSwitch do ;
  800.                     while not TabSwitch do ;
  801.                     writeln(CR,'                                     ' );
  802.                     RefreshCBuff(CB);
  803.                 end;
  804.  
  805.                 if (I=0) or ((I=1) and (CurrPList^.Node<>MenuNode))
  806.                 then begin       { Pop off command }
  807.                     if CurrPList<>Dummy then begin
  808.                         BackCBuff( CB, CurrPList^.PrevPList^.CmdI );
  809.                     end;
  810.                 end;
  811.  
  812.                 if (I=-1) and not HelpMode then begin
  813.                     writeln;
  814.                     Done := True;
  815.                 end;
  816.  
  817.             until Done or (CurrPList=Dummy);
  818.  
  819.         end else
  820.         
  821.         if (C=CommentChar) then begin
  822.             if not Comment then begin
  823.                 Comment := True;
  824.                 CommPos := BufCur;
  825.             end;
  826.             IntoCBuff( CB, C );
  827.         end else 
  828.  
  829.         if (C=CR) then
  830.         begin
  831.             IntoCBuff( CB, ' ' );
  832.             case ParseAll( CB ) of
  833.  
  834.             ParsedOK:
  835.                 if HelpMode then begin
  836.                     Done := CurrPList^.PrevPList=NIL;
  837.                     if CurrPList^.Selection=1 then 
  838.                         ExplainHelp
  839.                     else begin
  840.                         writeln;
  841.                         if not Done then begin
  842.                             DoHelp;
  843.                             if CurrPList^.Node<>MenuNode then
  844.                                 BackCBuff( CB, CurrPList^.PrevPList^.CmdI )
  845.                             else 
  846.                                 BackCBuff( CB, BufCur-1 );
  847.                             RefreshCBuff(CB); 
  848.                         end;
  849.                     end;
  850.                 
  851.                 end else begin
  852.                     writeln;
  853.                     with CurrPList^ do
  854.  
  855.                     if HelpPos>0 then begin
  856.                         if PrevPList^.CmdI=HelpPos then begin { HELP last com.}
  857.                             writeln;
  858.                             ParseCommand( CurrPList^.CurrMenu, Dummy, 
  859.                                     True, false );
  860.                             DestroyPList( Dummy );
  861.                         end else begin
  862.                             writeln;
  863.                             PrintHelpText;
  864.                             writeln;
  865.                             if Node=MenuNode then begin
  866.                                 PrintMatching;
  867.                                 writeln;
  868.                             end;
  869.                         end;
  870.                         RefreshCBuff(CB);
  871.  
  872.                     end else if (CurrMenu=Root) and (Node=MenuNode) then
  873.                         PListPtr := NIL      { Nothing parsed (or a new}
  874.                                              { entry would have been pushed)}
  875.                     else begin           
  876.                         if Node=MenuNode then begin
  877.                               { OK so far, but haven't got all of command }
  878.                             ParseCommand( CurrMenu, Dummy, 
  879.                                     false, false );
  880.                             if (Dummy=NIL) then begin   { Quit command }
  881.                                 DestroyPList(PListPtr);
  882.                                 PListPtr := NIL;
  883.                             end else begin              { link in cmd tail }
  884.                                 CurrPList^.PrevPList^.NextPList := Dummy;
  885.                                 Dummy^.PrevPList := CurrPList^.PrevPList;
  886.                                 DestroyPList(CurrPList);
  887.                                 CurrPList := Dummy;
  888.                             end;
  889.                         end;
  890.                     end;
  891.                     if HelpPos>0 then
  892.                         BackCBuff( CB, HelpPos )
  893.                     else
  894.                         Done := true;
  895.                 end;
  896.  
  897.             NotUnique:
  898.                 begin
  899.                     BackCBuff( CB, BufCur-1 );
  900.                     writeln;
  901.                     write( CommNotUnique );
  902.                     ShowWord( CB ); 
  903.                     writeln;
  904.                     PrintMatching;
  905.                     if CmdLevel>0 then begin
  906.                         RefreshCBuff( CB );
  907.                         BackCBuff( CB, 1 )
  908.                     end else begin
  909.                         BackCBuff(CB, CmdEndCBuff(CB));
  910.                         RefreshCBuff( CB );
  911.                     end;
  912.                 end;
  913.  
  914.             NotFound:
  915.                 begin
  916.                     BackCBuff( CB, BufCur-1 );
  917.                     writeln;
  918.                     write('?No match for word: ');
  919.                     ShowWord(CB);
  920.                     writeln; 
  921.                     PrintAlts;
  922.                     RefreshCBuff( CB );  { ... and start over }
  923.                     if CmdLevel>0 then
  924.                         BackCBuff( CB, 1 );
  925.                 end;
  926.  
  927.             end;
  928.             QuestionMark := false;
  929.  
  930.         end else
  931.  
  932.         if (C='?') and (not Comment) then begin
  933.  
  934.             PRes := ParseAll( CB );
  935.             if QuestionMark and not HelpMode then begin
  936.                 writeln;
  937.                 ParseCommand( CurrPList^.CurrMenu, Dummy, True, false );
  938.                 DestroyPList( Dummy );
  939.                 QuestionMark := False;
  940.                 RefreshCBuff( CB );
  941.  
  942.             end else begin
  943.  
  944.                 case PRes of 
  945.                 
  946.                 ParsedOK:
  947.                     if HelpMode then begin
  948.                         writeln('?');
  949.                         DoHelp;
  950.                         RefreshCBuff(CB);
  951.                     end else if BufCur=CurrPList^.CmdI then
  952.                     begin
  953.                         writeln('?');
  954.                         PrintAlts;
  955.                         RefreshCBuff(CB);
  956.                     end;
  957.                 
  958.                 NotFound:
  959.                     begin
  960.                         writeln('?');
  961.                         write('?No match for word: ');
  962.                         ShowWord(CB);
  963.                         writeln; 
  964.                         if CmdLevel>0 then begin
  965.                             RefreshCBuff( CB );
  966.                             BackCBuff( CB, 1 )
  967.                         end else begin
  968.                             PrintAlts;
  969.                             RefreshCBuff( CB );  { ... and start over }
  970.                         end;
  971.                     end;
  972.                     
  973.                 NotUnique:
  974.                     begin
  975.                         writeln('?');
  976.                         PrintMatching;
  977.                         QuestionMark := True;
  978.                         if CmdLevel>0 then begin
  979.                             RefreshCBuff( CB );
  980.                             BackCBuff( CB, 1 );
  981.                         end else begin
  982.                             BackCBuff(CB, CmdEndCBuff(CB));
  983.                             RefreshCBuff( CB );
  984.                         end;
  985.                     end;
  986.                 end;
  987.                 
  988.                 QuestionMark := True;
  989.             end;
  990.  
  991.         end else
  992.  
  993.         if (C=Escape) and (not Comment) then begin
  994.              
  995.             QuestionMark := False;
  996.  
  997.             if BufCur>CurrPList^.CmdI then begin
  998.  
  999.                 PRes := ParseAll(CB);
  1000.                 case PRes of
  1001.         
  1002.                 ParsedOK:
  1003.                     begin
  1004.                         CmdEnd := CmdEndCBuff(CB);
  1005.                         if CmdEnd=BufCur then
  1006.                             with CurrPList^ do begin
  1007.                                 {$Range-}
  1008.                                 Matching := 
  1009.                                     CurrMenu^.MPtr^.Commands[Selection];
  1010.                                 {$Range=}
  1011.                                 I := CmdI;
  1012.                                 J := 1;
  1013.                                 while (I<CmdEnd) and (J<=Length(Matching)) 
  1014.                                 do begin
  1015.                                     if CComp( Matching[J], Cmd[I] ) then begin
  1016.                                         J := J+1;
  1017.                                         I := I+1;
  1018.                                     end else begin
  1019.                                         if Cmd[I]='-' then begin
  1020.                                             J := J+1;
  1021.                                         end;
  1022.                                     end;
  1023.                                 end;
  1024.                                 for I := J to Length(Matching) do begin
  1025.                                     IntoCBuff( CB, Matching[I] );
  1026.                                 end;
  1027.                                 if PRes=ParsedOK then { expect more commands }
  1028.                                 begin
  1029.                                     IntoCBuff( CB, ' ' );
  1030.                                 end;        
  1031.                             end;
  1032.                     end;
  1033.                     
  1034.                 NotFound:
  1035.                     begin
  1036.                         write('?No match for word: ');
  1037.                         ShowWord(CB); 
  1038.                         writeln;
  1039.                         if CmdLevel>0 then begin
  1040.                             RefreshCBuff( CB );  { ... and start over }
  1041.                             BackCBuff( CB, 1 );
  1042.                         end else begin
  1043.                             PrintAlts;
  1044.                             RefreshCBuff( CB );  { ... and start over }
  1045.                         end;
  1046.                     end;
  1047.                     
  1048.                 NotUnique:
  1049.                     begin 
  1050.                         writeln;
  1051.                         write(CommNotUnique);
  1052.                         ShowWord(CB);
  1053.                         writeln;
  1054.                         if CmdLevel>0 then begin
  1055.                             RefreshCBuff( CB );
  1056.                             BackCBuff( CB, 1 )
  1057.                         end else begin
  1058.                             BackCBuff(CB, CmdEndCBuff(CB));
  1059.                             PrintMatching;
  1060.                             RefreshCBuff( CB );
  1061.                         end;
  1062.                     end;
  1063.  
  1064.                 end;
  1065.             end;
  1066.         end else
  1067.         
  1068.         if (C=BS) or (C=DEL) then begin
  1069.             if BufCur=1 then
  1070.                 write( chr(7) )
  1071.             else
  1072.                 BackCBuff( CB, BufCur-1 );
  1073.             QuestionMark := False;
  1074.         end else 
  1075.  
  1076.         if (C=CtrlW) then begin
  1077.             if (CurrPList^.CmdI=BufCur) then begin
  1078.                 if CurrPList^.PrevPList<>NIL then
  1079.                     BackCBuff( CB, CurrPList^.PrevPList^.CmdI );
  1080.             end else 
  1081.                 BackCBuff(CB, CurrPList^.CmdI );
  1082.             QuestionMark := False;
  1083.         end else
  1084.  
  1085.         if (C=CtrlX) or (C=CtrlU) then begin
  1086.             BackCBuff( CB, 1 );
  1087.             QuestionMark := False;
  1088.         end else 
  1089.  
  1090.         begin { normal character }
  1091.             QuestionMark := False;
  1092.             if (C>=' ') and (C<DEL) then begin
  1093.                 IntoCBuff( CB, C );
  1094.             end;       
  1095.         end;
  1096.  
  1097.     end { while };
  1098.     dispose( HFBuff );
  1099.     
  1100. end;    { ParseCommand }
  1101.  
  1102. {===========================================================================}
  1103.  
  1104. function    GetMenuAnswer( MPtr:pNameDesc;  NPix:integer ):integer;
  1105.     {   Returns 0 for press outside menu }
  1106. var     ResPtr  :   ResRes;
  1107.  
  1108.     Handler OutSide;
  1109.     begin
  1110.         ResPtr:=NIL;
  1111.         exit(Menu);
  1112.     end;  { OutSide }
  1113.  
  1114. begin { GetMenuAnswer }
  1115.     Menu(   MPtr,
  1116.             NotList,
  1117.             1,
  1118.             MPtr^.NumCommands,
  1119.             UseCursorPos,
  1120.             UseCursorPos,
  1121.             NPix,   {Number of pixels (height)}
  1122.             ResPtr);
  1123.     if ResPtr <> NIL then begin
  1124.         GetMenuAnswer := ResPtr^.Indices[1];
  1125.         DestroyRes( ResPtr );
  1126.     end
  1127.     else
  1128.         GetMenuAnswer := 0;
  1129. end; { GetMenuAnswer }
  1130.  
  1131. {=============================================================================}
  1132.  
  1133. procedure   DestroyPList( var PListPtr : pPListEntry );
  1134. var Trail : pPListEntry;
  1135. begin
  1136.     while PListPtr<>NIL do begin
  1137.         Trail := PListPtr;
  1138.         case Trail^.Node of
  1139.         
  1140.             EndNode:
  1141.                 begin
  1142.                     PListPtr := NIL;
  1143.                     dispose( Trail, EndNode );
  1144.                 end;
  1145.             
  1146.             ParmNode:
  1147.                 begin
  1148.                     PListPtr := NIl;
  1149.                     dispose( Trail, ParmNode );
  1150.                 end;
  1151.                
  1152.             MenuNode:
  1153.                 begin
  1154.                     PListPtr := Trail^.NextPList;
  1155.                     Trail^.NextPList := NIL;
  1156.                     dispose( Trail, MenuNode );
  1157.                 end;
  1158.         end;
  1159.     end;
  1160. end;  
  1161.     
  1162. {=============================================================================}
  1163.  
  1164. procedure   GetPList(           Root : pMenuEntry; 
  1165.                         var PListPtr : pPListEntry ); 
  1166.  
  1167. begin
  1168.     SCurOn;
  1169.     PListPtr := NIL;
  1170.     ParseCommand( Root, PListPtr, false, true );
  1171.     SCurOff;
  1172. end;
  1173.  
  1174. {=============================================================================}
  1175.  
  1176. function GetMenu( MenuFName, HelpFName : String ) : pMenuEntry;
  1177.  
  1178. VAR MenuFile            : Text;
  1179.     Blk, Bits           : Integer;
  1180.     SegSize             : Integer;
  1181.     MenuF               : FileID;
  1182.     Root                : pMenuEntry;
  1183.     MMP                 : MMPointer;
  1184.     HelpFile            : pInt;
  1185.     MenuSeg, OldSeg     : SegmentNumber;                      
  1186.  
  1187.     exception BadMenuSeg;
  1188.  
  1189.     handler BadMenuSeg;
  1190.     begin
  1191.         GetMenu := NIL;
  1192.         exit( GetMenu );
  1193.     end;
  1194.     
  1195.     procedure FixPointer( var ME : pMenuEntry );
  1196.     var MME : record case boolean of
  1197.                 true:   ( MM : MMPointer);
  1198.                 false:  ( E  : pMenuEntry);
  1199.              end;
  1200.     begin
  1201.         with MME do begin
  1202.             E := ME;
  1203.             with MM do begin
  1204.                 if (Segmen<>OldSeg) or (Offset>SegSize) then
  1205.                     raise BadMenuSeg;
  1206.                 Segmen := MenuSeg;
  1207.             end;
  1208.             ME := E;
  1209.         end;
  1210.     end;
  1211.                       
  1212.     procedure ValidatePtrs( ME : pMenuEntry );
  1213.     var i       : integer;
  1214.         TME     : pMenuEntry;
  1215.     begin
  1216.         with ME^ do begin
  1217.             case Node of            
  1218.                 MenuNode:
  1219.                     begin
  1220.                         TME := recast( MPtr, pMenuEntry );
  1221.                         FixPointer( TME );
  1222.                         MPtr := recast( TME, pNameDesc );
  1223.                         for i := 2 to MPtr^.NumCommands do begin 
  1224.                             {$range-}
  1225.                             FixPointer( NextLevel[i] );
  1226.                             ValidatePtrs( NextLevel[i] );
  1227.                             {$range=}
  1228.                         end;
  1229.                     end;
  1230.        
  1231.                 EndNode, ParmNode:
  1232.                     ;
  1233.             end;
  1234.         end;
  1235.     end;
  1236.  
  1237. begin
  1238.     MenuF := FSLookUp( MenuFName, Blk, Bits );
  1239.     if MenuF=0 then
  1240.         raise NoMenuFile( MenuFName )
  1241.     else begin
  1242.         CreateSegment( MenuSeg, Blk, 1, Blk );
  1243.         SegSize := (Blk-1)*256 + (Bits div 16);
  1244.         Root := MakePtr( MenuSeg, WordSize( integer ), pMenuEntry );
  1245.         MultiRead( MenuF, MakePtr( MenuSeg, 0, pDirBlk ), 0, Blk ); 
  1246.         MMP := recast( Root^.MPtr, MMPointer );
  1247.         OldSeg := MMP.Segmen;
  1248.         ValidatePtrs( Root );
  1249.         HelpFile := MakePtr( MenuSeg, 0, pInt );
  1250.         HelpFile^ := FSLookUp( HelpFName, Blk, Bits );  
  1251.     end;
  1252.     GetMenu := Root;
  1253. end;
  1254.  
  1255. {=============================================================================}
  1256.  
  1257. procedure InitMenues;
  1258. begin
  1259.     {$Range-}
  1260.     AllocNameDesc( 1, DefSeg, NullMenu );
  1261.     with NullMenu^ do begin
  1262.         Header := 'Confirm:';
  1263.         Commands[1] := '?';
  1264.     end;
  1265.     AllocNameDesc( 2, DefSeg, EndMenu );
  1266.     with EndMenu^ do begin
  1267.         Header := 'Confirm selection:';
  1268.         Commands[1] := '?';
  1269.         Commands[2] := 'Perform command';
  1270.     end;
  1271.     AllocNameDesc( 3, DefSeg, ParmMenu );
  1272.     with ParmMenu^ do begin
  1273.         Header := 'Command arguments:';
  1274.         Commands[1] := '?';
  1275.         Commands[2] := 'Enter arguments';
  1276.         Commands[3] := 'No arguments';
  1277.     end;
  1278.     {$Range=}
  1279.     InitPopUp;
  1280.     IOCursorMode(TrackCursor);
  1281.     CmdLevel := 0;
  1282.     PromptChar := KeyChar;
  1283. end;
  1284.  
  1285.  
  1286. {=============================================================================}
  1287.  
  1288.     
  1289. procedure DestroyMenues;
  1290. var CI : integer;
  1291. begin
  1292.     DestroyNameDescr( NullMenu );
  1293. end.
  1294.